home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
faq-s.zip
/
SETUP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-04
|
26KB
|
895 lines
program setup;
{$R-,S+,I-,D+,F-,V-,B-,N-,L+ }
{$M 16384,5000,5000 }
uses dos,crt,video,xcrt,general,gentypes,configrt,faqload3;
var i1,i2,i3:integer;
c:char;
const configver='1.00';
type ScreenType = array [0..3999] of Byte;
var ScreenAddr : ScreenType absolute $B800:$0000;
{ TheDraw Pascal Crunched Screen Image }
const
SETUP_SCR_WIDTH=80;
SETUP_SCR_DEPTH=23;
SETUP_SCR_LENGTH=743;
SETUP_SCR : array [1..743] of Char = (
#11,#16,#26,'O','▓',#24,#26,'O','▓',#24,#26,'O','▓',#24,#26,#18,'▓',
#17,#25,'(',#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,#25,#4 ,
#15,'F','A','Q',' ','S','e','t','u','p',' ','P','r','o','g','r','a',
'm',' ','V','e','r','s','i','o','n',' ','1','.','0','0',#25,#5 ,#11,
#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#15,#17,#26,'(','─',#11,
#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',' ',#1 ,'█','█',
'█',' ',' ',#26,#23,'█',' ','█','█',#25,#2 ,'█','█','█',' ',#11,#16,
#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,'█','█',#25,#2 ,
'█','█',' ',' ',#15,'B',#11,'B','S',' ','I','n','f','o','r','m','a',
't','i','o','n',#25,#7 ,#1 ,'█',' ',' ','█','█',#25,#2 ,#11,#16,#26,
#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,'█','█',' ','█',' ',
'█','█',' ','█',#15,'M',#11,'o','d','e','m',' ','I','n','f','o','r',
'm','a','t','i','o','n',#1 ,#26,#6 ,'█',' ',' ','█','█',' ','█',' ',
#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,
'█',' ',#26,#3 ,'█',#15,'L',#11,'e','v','e','l','s',#25,#10,#1 ,#26,
#6 ,'█',' ',' ',#26,#3 ,'█',' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',
#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',#26,#3 ,'█',#15,'T',#11,'i',
'm','e','s',#25,#11,#1 ,#26,#6 ,'█',' ',' ',#26,#3 ,'█',' ',#11,#16,
#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',
#26,#3 ,'█',#11,'C',#15,'o',#11,'l','o','r','s',#25,#10,#1 ,#26,#6 ,
'█',' ',' ',#26,#3 ,'█',' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,
'▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',#26,#3 ,'█',#15,'C',#11,'o','n',
'f','e','r','e','n','c','e','s',#25,#5 ,#1 ,#26,#6 ,'█',' ',' ',#26,
#3 ,'█',' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',
#1 ,#26,#3 ,'█',' ',#26,#3 ,'█',#11,'C','e','l','e','r','i','t','y',
#15,'N',#11,'e','t',#25,#5 ,#1 ,#26,#6 ,'█',' ',' ',#26,#3 ,'█',' ',
#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,
'█',' ',#26,#3 ,'█',#11,'N','e','w',' ','U','s','e','r',' ',#15,'V',
#11,'o','t','i','n','g',' ',' ',#1 ,#26,#6 ,'█',' ',' ',#26,#3 ,'█',
' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,
#3 ,'█',' ',#26,#3 ,'█',#15,'F',#11,'i','l','e',' ','S','e','c','t',
'i','o','n',' ','I','n','f','o',#1 ,#26,#6 ,'█',' ',' ',#26,#3 ,'█',
' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',' ',#1 ,
'█','█','█',' ',' ','█','█','█',#15,'S',#11,'t','r','i','n','g','s',
#25,#9 ,#1 ,#26,#6 ,'█',#25,#2 ,'█','█','█',' ',#11,#16,#26,#19,'▓',
#24,#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',#26,#3 ,'█',
#11,'M',#15,'i',#11,'s','c','e','l','l','a','n','e','o','u','s',#25,
#3 ,#1 ,#26,#6 ,'█',' ',' ',#26,#3 ,'█',' ',#11,#16,#26,#19,'▓',#24,
#26,#16,'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',#26,#3 ,'█',#15,
'E',#11,'x','i','t',' ','a','n','d',' ','S','a','v','e',#25,#3 ,#1 ,
#26,#6 ,'█',' ',' ',#26,#3 ,'█',' ',#11,#16,#26,#19,'▓',#24,#26,#16,
'▓',#3 ,'▓','▓',#17,' ',#1 ,#26,#3 ,'█',' ',#26,#27,'█',' ',' ',#26,
#3 ,'█',' ',#11,#16,#26,#19,'▓',#24,#26,#16,'▓',#3 ,#26,'(','▓',#11,
#26,#21,'▓',#24,#26,'O','▓',#24,#26,'O','▓',#24);
procedure UNCRUNCH (var Addr1,Addr2; BlkLen:Integer);
begin
inline (
$1E/$C5/$B6/Addr1/$C4/$BE/Addr2/$8B/$8E/BlkLen/$8B/$D7/$33/$C0/
$FC/$AC/$3C/$1B/$75/$05/$80/$F4/$80/$EB/$4D/$3C/$10/$73/$07/
$80/$E4/$70/$0A/$E0/$EB/$42/$3C/$18/$74/$13/$73/$19/$2C/$10/
$02/$C0/$02/$C0/$02/$C0/$02/$C0/$80/$E4/$8F/$0A/$E0/$EB/$2B/
$81/$C2/$A0/$00/$8B/$FA/$EB/$23/$3C/$19/$75/$0B/$AC/$51/$32/$ED/
$8A/$C8/$B0/$20/$EB/$0D/$90/$3C/$1A/$75/$0F/$AC/$49/$51/$32/$ED/
$8A/$C8/$AC/$E3/$03/$AB/$E2/$FD/$59/$49/$AB/$E3/$02/$E2/$A5/$1F);
end;
procedure writeconfig;
var q:file of configsettype;
begin
assign (q,'SETUP.CFG');
rewrite (q);
write (q,configset);
close (q)
end;
procedure cursor (b:boolean);
var r:registers;
begin
with r do begin
ah:=$01;
if not b then begin
ch:=$20; cl:=$20
end else begin
ch:=5; cl:=7
end
end;
intr ($10,r)
end;
procedure formatconfig;
var cnt,i:integer;
begin
versioncode:=thisversioncode;
longname[0]:=#0;
sysopname[0]:=#0;
getdir (0,faqdir);
if faqdir[length(faqdir)]<>'\' then faqdir:=faqdir+'\';
textdir:=faqdir+'MSGS\';
uploaddir:=faqdir+'GFILES\';
datadir:=faqdir+'DATA\';
asciidownload:='From a FAQ Board';
textfiledir:=faqdir+'MENUS\';
doordir:=faqdir+'DOORS\';
networkdir:=faqdir+'NETWORK\';
xferdir:=faqdir+'UPLOADS\';
bbsdatadir:=faqdir+'BBSDATA\';
lockoutpw:='No 300!';
downloadpw:='Don''t D/L with 300!';
modemsetupstr:='';
modemhangupstr:='+++~~~ATH|';
modemdialprefix:='ATDT';
modemdialsuffix:='|';
defbaudrate:=2400;
usecom:=1;
answerring:=1;
offlocal:=false;
offcall:=false;
lockport:=false;
usrspeed:=0;
inbuf:=1024;
outbuf:=1024;
anonymouslevel:=50;
defcolor1:=9;
defcolor2:=11;
defcolor3:=15;
defcolor4:=12;
defcolor5:=9;
defcolor6:=15;
numwelcomes:=1;
mintimeout:=5;
sysoplevel:=200;
defuserlevel:=1;
defudlevel:=0;
mprompt:='Gateway Command: ';
mhelp :='?';
syst1 :='1';
syst2 :='';
syst3 :='';
mnew :='2';
mcheck:='3';
mfback:='4';
mchat :='5';
mlogoff:='6';
mansi :='7';
defudpoints:=0;
normbotcolor:=9;
normtopcolor:=15;
outlockcolor:=11;
splitcolor:=12;
statlinecolor:=3;
uploadfactor:=2;
private:=false;
autologin:=false;
useconmode:=true;
escinmsgs:=true;
bkspinmsgs:=true;
req1name:='New User Application';
require1:=true;
req2name:='';
require2:=false;
req3name:='';
require3:=false;
req4name:='';
require4:=false;
req5name:='';
require5:=false;
dotchar:='/';
supportedrates:=[b1200]+[b2400];
downloadrates:=supportedrates;
availtime:='4:00 pm';
unavailtime:='10:00 pm';
xmodemopentime:='3:00 am';
xmodemclosetime:='3:00 am';
for cnt:=1 to 100 do usertime[cnt]:=cnt*2;
logonlevel:=10;
postlevel:=10;
anonymousstr:='[ Anonymous ]';
matrixtype:=1;
newusermatrix:=true;
systempassword:='FAQRULEZ';
newuserpass[0]:=#0;
remotedoors:=false;
allowdoors:=false;
eventtime[0]:=#0;
eventbatch[0]:=#0;
directvideomode:=true;
checksnowmode:=true;
hangnewusers:=true;
msgnextlvl:=10;
useconf:=true;
for i:=1 to 5 do begin
confm[i]:=#0;
confx[i]:=#0;
confmpw[i]:=#0;
confxpw[i]:=#0;
defconfm[i]:=false;
defconfx[i]:=false;
end;
confm[1]:='Elite Posts';
confx[1]:='(MS*IBM) Files';
confm[2]:='Sysop Posts';
confx[2]:='(Sysop) Files';
qvmainl:=50;
qvxferl:=50;
qvxferp:=0;
qvgfile:=50;
qvnote :='Validated User';
appear:='The Sysop is here.';
disappear:='The Sysop is gone.';
telenumber:='ARE PRE SUFF';
allowloan:=false;
lvltoloan:=50;
maxloan:=5;
timerestlvl:=1;
timereststart[0]:=#0;
timerestend[0]:=#0;
dszlogname:=faqdir+'DSZ.LOG';
jshutup:=true;
newusernote:='New User';
system2password[0]:=#0;
system3password[0]:=#0;
availstr:='The Sysop is available for chat.';
notavailstr:='The Sysop is not available for chat.';
useqr:=true;
qrlimit:=-25;
qrmultifactor:=5;
qrexempt:=60;
usecliche:=true;
cliche:='FAQ - The RIGHT one!';
ulpercent:=50;
checkautologin:=true;
usegambling:=true;
chance :=20;
gain :=5;
numpoints :=100;
numthrows :=5;
convrate :=10;
maxdeposit :=120;
albank :=true;
aldarts :=true;
alrr :=true;
alrb :=true;
alhl :=true;
alr :=true;
alc :=true;
usetimebank:=true;
readanonlvl:=50;
listuserlvl:=40;
ems:=false;
datascrambling:=false;
internalm:=true;
pcrexempt:=70;
xferpcr:=25;
gfpcr:=20;
gfratio:=20;
udratio:=20;
udexempt:=60;
doorpcr:=15;
matrixfback:=true;
matrixreqchat:=true;
ansiedit:='C:\UTILS\THEDRAW\THEDRAW.EXE';
editor:='C:\UTILS\Q\Q.EXE';
usequote:=true;
filepw:=true;
autovalidate:=false;
pointvalue:=50;
zipcomment:=false;
netnum:=1;
netpas:='Network Password';
usenet:=false;
featurea:=false;
featureb:=false;
featurec:=false;
featured:=false;
featuree:=false;
featuref:=false;
featureg:=false;
featureh:=false;
featurej:=false;
netcomment:='The Board - ARE-PRE-SUFF [FAQ]';
netstart:='';
netend :='';
hostphone[0]:=#0;
extender:='1';
promptformat:='^01<^03^08^01/^03^09^01>^07';
promptformat1:='^01[^03^1^01] [^03^2^01] <^03?/Help^01>^04: ';
usemouse:=false;
usenuv:=false;
newvotelvl:=50;
autonuv:=false;
valnu:=10;
delnu:=5;
volvl:=50;
voflvl:=50;
vofps:=0;
leechweek:=false;
sblaster:=false;
writeconfig
end;
function getbaudstr (var q:baudset):lstr;
var w:lstr;
cnt:baudratetype;
begin
w[0]:=chr(0);
for cnt:=firstbaud to lastbaud do
if cnt in q then w:=w+strlong(baudarray[cnt])+' ';
if length(w)=0 then w:='None';
getbaudstr:=w
end;
procedure baudconf (q:baudset; typeit:string);
var i,iii:integer;
baudnum:integer;
ii:baudratetype;
c:char;
b:boolean;
s:screens;
procedure writecurrentplace (i:integer; q:baudset);
var ii,iii:integer;
begin
textbackground (7); textcolor (15);
case i of
1:begin gotoxy (7,9); if b300 in q then write ('√') else write (' '); end;
2:begin gotoxy (7,10); if b1200 in q then write ('√') else write (' '); end;
3:begin gotoxy (7,11); if b2400 in q then write ('√') else write (' '); end;
4:begin gotoxy (7,12); if b4800 in q then write ('√') else write (' '); end;
5:begin gotoxy (7,13); if b9600 in q then write ('√') else write (' '); end;
6:begin gotoxy (7,14); if b19200 in q then write ('√') else write (' '); end;
7:begin gotoxy (7,15); if b38400 in q then write ('√') else write (' '); end;
end;
textcolor (15);
textbackground (0);
end;
begin
readscr (s);
baudnum:=1;
textbackground (1);
for i:=8 to 16 do begin
gotoxy (6,i); write (' '); end;
gotoxy (9,9); write ('300');
gotoxy (9,10); write ('1200');
gotoxy (9,11); write ('2400');
gotoxy (9,12); write ('4800');
gotoxy (9,13); write ('9600');
gotoxy (9,14); write ('19200');
gotoxy (9,15); write ('38400');
for i:=9 to 16 do begin gotoxy (4,i); textbackground (0); write (' '); end;
for i:=4 to 13 do begin gotoxy (i,17); textbackground (0); write (' '); end;
repeat
iii:=7;
textbackground (1); textcolor (15);
for ii:=firstbaud to lastbaud do begin
inc (iii);
if ii in q then begin gotoxy (7,iii); write ('√') end else begin
gotoxy (7,iii); write (' ');
end; end;
writecurrentplace (baudnum,q);
c:=upcase (readkey);
case c of
#72:begin
if baudnum=1 then baudnum:=8;
baudnum:=baudnum-1;
end;
#80:begin
if baudnum=7 then baudnum:=0;
baudnum:=baudnum+1;
end;
' ':begin
case baudnum of
1:if b300 in q then q:=q-[b300] else q:=q+[b300];
2:if b1200 in q then q:=q-[b1200] else q:=q+[b1200];
3:if b2400 in q then q:=q-[b2400] else q:=q+[b2400];
4:if b4800 in q then q:=q-[b4800] else q:=q+[b4800];
5:if b9600 in q then q:=q-[b9600] else q:=q+[b9600];
6:if b19200 in q then q:=q-[b19200] else q:=q+[b19200];
7:if b38400 in q then q:=q-[b38400] else q:=q+[b38400];
end;
end;
end;
until (c=#27) or (c=#13);
if typeit='S' then supportedrates:=q;
if typeit='D' then downloadrates:=q;
writescr (s);
end;
function colorconf (currcolor:integer; backgr:boolean):integer;
var i,ii,iii,
i2,ii2:integer;
b:boolean;
c:char;
s:screens;
procedure writecurcolor (color,back:integer);
var i:integer;
begin
textbackground (3);
for i:=0 to 16 do begin
gotoxy (7+i,12); textcolor (15); if i=color then write ('F') else write (' ');
gotoxy (7+i,14); textcolor (15); if i=back then write ('B') else write (' ');
end;
end;
begin
readscr (s);
b:=false;
ii:=15;
iii:=0;
for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,9);
write (' '); end;
for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,10);
write (' '); end;
for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,11);
write ('─'); end;
for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,12);
write (' '); end;
for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,13);
write (' '); end;
for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,14);
write (' '); end;
for i:=6 to 23 do begin textcolor (15); textbackground (3); gotoxy (i,15);
write (' '); end;
for i:=10 to 15 do begin textcolor (15); textbackground (0); gotoxy (4,i); write (' ');
end;
for i:=4 to 21 do begin textcolor (15); textbackground (0); gotoxy (i,16); write (' ');
end;
repeat
gotoxy (8,10); textcolor (ii); textbackground (iii);
write ('Current Color');
gotoxy (7,12);
textbackground (3); textcolor (15);
for i:=0 to 15 do begin gotoxy (7+i,13); textcolor (i);
write ('█'); end;
gotoxy (7,12);
writecurcolor (ii,iii);
c:=readkey;
case c of
#77:begin if ii=15 then ii:=-1;
ii:=ii+1;
end;
#75:begin if ii=0 then ii:=16;
ii:=ii-1;
end;
#72:begin if iii=7 then iii:=-1;
iii:=iii+1;
end;
#80:begin if iii=0 then iii:=8;
iii:=iii-1;
end;
#27:colorconf:=currcolor;
#13:begin iii:=iii*16;
b:=true;
if backgr then
colorconf:=ii+iii else colorconf:=ii; end;
end
until (b=true) or (c=#27);
writescr (s);
end;
{ procedure dousertime;
var input:lstr;
n:integer;
buffer:array [1..4096] of byte;
b:block;
procedure refresh;
var cnt:integer;
begin
clearwindow (normalcolor);
gotoxy (1,1);
cn;
writeln('Level Time │ Level Time │ Level Time │ Level Time │ Level Time');
writeln('───────────┼────────────┼────────────┼────────────┼───────────');
gotoxy (1,3);
for cnt:=1 to 100 do begin
write (cnt:4,': ',usertime[cnt]:4);
if (cnt mod 5)=0 then writeln else write (' │ ')
end
end;
procedure setone (n,v:integer);
var x,y:integer;
begin
x:=((n-1) mod 5)*13+7;
y:=((n-1) div 5)+3;
gotoxy (x,y);
write (v:4);
usertime[n]:=v
end;
procedure getone (n:integer);
var x,y,v:integer;
begin
x:=((n-1) mod 5)*13+7;
y:=((n-1) div 5)+3;
gotoxy (x,y);
write (' ');
gotoxy (x,y);
buflen:=4;
readln (input);
v:=valu(input);
if (v<1) or (v>1000) then v:=usertime[n];
setone (n,v)
end;
function getn (txt:lstr):integer;
var input:lstr;
begin
gotoxy (2,23);
write (txt,': ');
clreol;
buflen:=4;
readln (input);
getn:=valu(input)
end;
function getlvl (txt:lstr):integer;
var n:integer;
begin
n:=getn (txt);
if (n<1) or (n>100) then n:=0;
getlvl:=n
end;
procedure pattern;
var st,en,ba,se,cn:integer;
begin
st:=getlvl ('Starting level of pattern');
if st=0 then exit;
en:=getlvl ('Ending level of pattern');
if en<st then exit;
ba:=getn ('Time for level '+strr(st));
if (ba<1) or (ba>1000) then exit;
se:=getn ('Additional time per level');
if (se<0) or (se>1000) then exit;
cn:=st;
repeat
setone (cn,ba);
if ba+se<1000
then ba:=ba+se
else ba:=1000;
cn:=cn+1
until cn>en
end;
var k:char;
begin
setblock (b,1,1,80,25);
readblock (b,buffer);
refresh;
repeat
repeat
gotoxy (1,24);
write ('Number to change, [P]attern, or [Q]uit: ');
clreol;
readln (input)
until length(input)>0;
k:=upcase(input[1]);
n:=valu(input);
if (n>=1) and (n<=100) then getone(n) else
case k of
'P':pattern
end
until k='Q';
writeblock (b,buffer)
end; }
procedure maybemakeconfig;
var f:file of configsettype;
a:char;
s,w:integer;
begin
s:=ofs(filler)-ofs(versioncode);
w:=sizeof(configsettype);
if s>w then begin
writeln;
writeln (' ERROR! Size of configuration is: ',s);
writeln (' Bytes being written : ',w);
writeln;
a:=upcase(readkey);
cursor (true);
textcolor (7);
textbackground (0);
clrscr;
halt
end;
assign (f,'SETUP.CFG');
reset (f);
if ioresult=0 then begin
close (f);
exit
end;
fillchar (configset,sizeof(configset),0);
formatconfig
end;
function inputinfo (desc1:string; desc2:string; writeto:string; buflength:integer):string;
var i,ii:byte;
temp:string;
s:screens;
ss:string[2];
begin
readscr (s);
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,10);
write (' '); end;
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,11);
write ('─'); end;
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,12);
write (' '); end;
for i:=11 to 13 do begin textcolor (15); textbackground (0); gotoxy (2,i); write (' ');
end;
for ii:=2 to 75 do begin textcolor (15); textbackground (0); gotoxy (ii,13); write (' ');
end;
gotoxy (1,24); textcolor (15); textbackground (1); clreol;
gotoxy (2,24); textcolor (15); textbackground (1); write (desc1);
gotoxy (1,25); textcolor (15); textbackground (1); clreol;
gotoxy (2,25); textcolor (15); textbackground (1); write (desc2);
gotoxy (5,10); textcolor (15); textbackground (1);
if length(writeto)>0 then
write ('Current Setting: '+writeto) else write ('No Setting!');
gotoxy (5,12); textcolor (15); textbackground (1);
write ('Input: ');
textcolor (11);
cursor (true);
ii:=1;
temp:=writeto;
while (temp[length(temp)]=' ') do delete(temp,length(temp),1);
editline(temp,ii,12,12,buflength,ss);
cursor (false);
if length(temp)<1 then temp:=writeto else writeto:=temp;
if upstring(temp)='N' then temp:='';
inputinfo:=temp;
writescr (s);
textcolor (15);
textbackground (0);
end;
function inputcharinfo (desc1:string; desc2:string; writeto:char; buflength:integer):char;
var i,ii:byte;
temp:string;
s:screens;
ss:string[2];
begin
readscr (s);
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,10);
write (' '); end;
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,11);
write ('─'); end;
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,12);
write (' '); end;
for i:=11 to 13 do begin textcolor (15); textbackground (0); gotoxy (2,i); write (' ');
end;
for ii:=2 to 75 do begin textcolor (15); textbackground (0); gotoxy (ii,13); write (' ');
end;
gotoxy (1,24); textcolor (15); textbackground (1); clreol;
gotoxy (2,24); textcolor (15); textbackground (1); write (desc1);
gotoxy (1,25); textcolor (15); textbackground (1); clreol;
gotoxy (2,25); textcolor (15); textbackground (1); write (desc2);
gotoxy (5,10); textcolor (15); textbackground (1);
if length(writeto)>0 then
write ('Current Setting: '+writeto) else write ('No Setting!');
gotoxy (5,12); textcolor (15); textbackground (1);
write ('Input: ');
textcolor (11);
cursor (true);
ii:=1;
temp:=writeto;
while (temp[length(temp)]=' ') do delete(temp,length(temp),1);
editline(temp,ii,12,12,buflength,ss);
cursor (false);
if length(temp)<1 then temp:=writeto else writeto:=temp[1];
if upstring(temp)='N' then temp:='';
inputcharinfo:=temp[1];
writescr (s);
textcolor (15);
textbackground (0);
end;
function inputintinfo (desc1:string; desc2:string; writeto:string; buflength,lowrange,highrange
:longint):longint;
var i,ii:byte;
temp:string;
s:screens;
ss:string[2];
begin
readscr (s);
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,10);
write (' '); end;
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,11);
write ('─'); end;
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,12);
write (' '); end;
for i:=11 to 13 do begin textcolor (15); textbackground (0); gotoxy (2,i); write (' ');
end;
for ii:=2 to 75 do begin textcolor (15); textbackground (0); gotoxy (ii,13); write (' ');
end;
repeat
gotoxy (1,24); textcolor (15); textbackground (1); clreol;
gotoxy (2,24); textcolor (15); textbackground (1); write (desc1+' - Range: ',lowrange,'-',highrange);
gotoxy (1,25); textcolor (15); textbackground (1); clreol;
gotoxy (2,25); textcolor (15); textbackground (1); write (desc2);
gotoxy (5,10); textcolor (15); textbackground (1);
if length(writeto)>0 then
write ('Current Setting: '+writeto) else write ('No Setting!');
gotoxy (5,12); textcolor (15); textbackground (1);
write ('Input: ');
textcolor (11);
cursor (true);
ii:=1;
temp:=writeto;
while (temp[length(temp)]=' ') do delete(temp,length(temp),1);
editline(temp,ii,12,12,buflength,ss);
cursor (false);
until (valul(temp)<=highrange) and (valul(temp)>=lowrange);
if length(temp)<1 then temp:=writeto else writeto:=temp;
inputintinfo:=valul(temp);
writescr (s);
textcolor (15);
textbackground (0);
end;
function inputbooinfo (desc1:string; desc2:string; writeto:boolean; buflength:integer):boolean;
var i,ii:byte;
temp:string;
s:screens;
ss:string[2];
begin
readscr (s);
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,10);
write (' '); end;
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,11);
write ('─'); end;
for i:=4 to 77 do begin textcolor (15); textbackground (1); gotoxy (i,12);
write (' '); end;
for i:=11 to 13 do begin textcolor (15); textbackground (0); gotoxy (2,i); write (' ');
end;
for ii:=2 to 75 do begin textcolor (15); textbackground (0); gotoxy (ii,13); write (' ');
end;
gotoxy (1,24); textcolor (15); textbackground (1); clreol;
gotoxy (2,24); textcolor (15); textbackground (1); write (desc1);
gotoxy (1,25); textcolor (15); textbackground (1); clreol;
gotoxy (2,25); textcolor (15); textbackground (1); write (desc2);
gotoxy (5,10); textcolor (15); textbackground (1); write ('Current Setting: ',writeto);
gotoxy (5,12); textcolor (15); textbackground (1);
write ('Input: ');
textcolor (11);
cursor (true);
ii:=1;
if writeto=true then temp:='Y' else if writeto=false then temp:='N';
while (temp[length(temp)]=' ') do delete(temp,length(temp),1);
editline(temp,ii,12,12,buflength,ss);
cursor (false);
if length(temp)<1 then begin
if writeto=true then temp:='Y' else if writeto=false then temp:='N';
end else begin
if upstring(temp)='Y' then writeto:=true else if upstring(temp)='N' then writeto:=false;
end;
if upstring(temp)='Y' then inputbooinfo:=true else
if upstring(temp)='N' then inputbooinfo:=false;
writescr (s);
textcolor (15);
textbackground (0);
end;
{$I setup2.pas}
procedure writecurrentplace(i:integer);
begin
if i=1 then begin
gotoxy (28,8); textcolor (15); textbackground (7); write ('» BBS Information ');
end;
if i=2 then begin
gotoxy (28,9); textcolor (15); textbackground (7); write ('» Modem Information ');
end;
if i=3 then begin
gotoxy (28,10); textcolor (15); textbackground (7); write ('» Levels ');
end;
if i=4 then begin
gotoxy (28,11); textcolor (15); textbackground (7); write ('» Times ');
end;
if i=5 then begin
gotoxy (28,12); textcolor (15); textbackground (7); write ('» Colors ');
end;
if i=6 then begin
gotoxy (28,13); textcolor (15); textbackground (7); write ('» Conferences ');
end;
if i=7 then begin
gotoxy (28,14); textcolor (15); textbackground (7); write ('» CelerityNet ');
end;
if i=8 then begin
gotoxy (28,15); textcolor (15); textbackground (7); write ('» New User Voting ');
end;
if i=9 then begin
gotoxy (28,16); textcolor (15); textbackground (7); write ('» File Section Info ');
end;
if i=10 then begin
gotoxy (28,17); textcolor (15); textbackground (7); write ('» Strings ');
end;
if i=11 then begin
gotoxy (28,18); textcolor (15); textbackground (7); write ('» Miscellaneous ');
end;
if i=12 then begin
gotoxy (28,19); textcolor (15); textbackground (7); write ('» Exit and Save ');
end;
textcolor (15);
textbackground (0);
end;
procedure writemainmenu;
begin
UNCRUNCH(SETUP_SCR,ScreenAddr[(1*2)+(1*160)-162],SETUP_SCR_LENGTH);
end;
var d:char;
begin
clrscr;
write ('View VGA Loader? [Must have VGA] [Y] ');
d:=upcase(readkey);
cursor (false);
if (d='Y') or (d=#13) then begin mainloader; clrscr; end else
if d='N' then clrscr;
cursor (false);
maybemakeconfig;
readconfig;
i1:=1;
repeat
writemainmenu;
writecurrentplace(i1);
c:=upcase(readkey);
case c of
'B':begin i1:=1;
end;
'M':begin i1:=2;
end;
'L':begin i1:=3;
end;
'T':begin i1:=4;
end;
'O':begin i1:=5;
end;
'C':begin i1:=6;
end;
'N':begin i1:=7;
end;
'V':begin i1:=8;
end;
'F':begin i1:=9;
end;
'S':begin i1:=10;
end;
'I':begin i1:=11;
end;
'E':begin i1:=12;
end;
#72:begin
if i1=1 then i1:=13;
i1:=i1-1;
end;
#80:begin
if i1=12 then i1:=0;
i1:=i1+1;
end;
#13:begin
case i1 of
1:bbsinfo;
2:modeminfo;
3:levels;
{4:usertime;}
5:colors;
6:conf;
7:netinfo;
8:nuv;
9:filesect;
10:strings;
{11:misc;}
12:begin writeconfig; clrscr; cursor (true); halt (0); end;
end;
end;
#27:begin clrscr; cursor (true); halt (0); end;
end;
until (0=1);
end.